Gurewich OLE Controls for Visual Basic 4/Gurewich OLE Controls for Visual Basic 4.iso/ocxprog/programs/ch15/wingbmp.frm

Visual Basic Form | 1995-08-25 | 6.1 KB | 200 lines

VERSION 4.00
Begin VB.Form frmWinGBMP
   Caption         =   "The WinG BMP Program"
   ClientHeight    =   5010
   ClientLeft      =   1095
   ClientTop       =   1830
   ClientWidth     =   6720
   Height          =   5700
   Icon            =   "WINGBMP.frx":0000
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   5010
   ScaleWidth      =   6720
   Top             =   1200
   Width           =   6840
   Begin MSComDlg.CommonDialog CommonDialog1
      Left            =   120
      Top             =   120
      _Version        =   65536
      _ExtentX        =   847
      _ExtentY        =   847
      _StockProps     =   0
      CancelError     =   -1  'True
   End
   Begin TegwingLibCtl.Tegwing Tegwing1
      Left            =   840
      Top             =   120
      _version        =   65536
      _extentx        =   1032
      _extenty        =   953
      _stockprops     =   0
   End
   Begin VB.Menu mnuFile
      Caption         =   "&File"
      Begin VB.Menu mnuOpen
         Caption         =   "&Open..."
      End
      Begin VB.Menu mnuSep1
         Caption         =   "-"
      End
      Begin VB.Menu mnuInfo
         Caption         =   "&Info..."
      End
      Begin VB.Menu mnuSep2
         Caption         =   "-"
      End
      Begin VB.Menu mnuExit
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuHelp
      Caption         =   "&Help"
      Begin VB.Menu mnuAbout
         Caption         =   "&About..."
      End
   End
Attribute VB_Name = "frmWinGBMP"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
Option Explicit
' Constants.
Const SRCERASE = &H440328
Const SRCINVERT = &H660046
Const SRCPAINT = &HEE0086
Const SRCAND = &H8800C6
Const SRCCOPY = &HCC0020
Dim gBMPHandle As Integer
Private Sub Form_Load()
    ' Open WinG.
    Tegwing1.hWndDisplay = Me.hWnd
    Tegwing1.OpenWinG
    Me.ScaleMode = 3
End Sub
Private Sub Form_Paint()
    ' Display the BMP file (if the BMP is open).
    If gBMPHandle > 0 Then
       DisplayBitmap (gBMPHandle)
    End If
End Sub
Private Sub Form_Resize()
    ' Close current WinG, start a new
    ' WinG session, and display the bitmap.
    Tegwing1.CloseWinG
    Tegwing1.hWndDisplay = Me.hWnd
    Tegwing1.OpenWinG
    If gBMPHandle <> 0 Then
       DisplayBitmap (gBMPHandle)
    End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
    ' Close WinG and close the bitmap.
    Tegwing1.CloseWinG
    Tegwing1.CloseBMP gBMPHandle
End Sub
Private Sub mnuAbout_Click()
   Dim Title
   Dim Msg
   Dim CR
   CR = Chr(13) + Chr(10)
   ' The title of the About message box.
   Title = "About the WinG BMP Program"
   ' Prepare the message of the About message box.
   Msg = "This program was written with Visual "
   Msg = Msg + "Basic for Windows, using the "
   Msg = Msg + "TegoSoft WinG OCX control. "
   Msg = Msg + CR + CR
   Msg = Msg + "The TegoSoft WinG OCX control "
   Msg = Msg + "enables you to perform fast graphics "
   Msg = Msg + "operations (such as display BMP files) "
   Msg = Msg + "using WinG technology."
   Msg = Msg + CR + CR
   Msg = Msg + "The TegoSoft WinG OCX control "
   Msg = Msg + "is part of the TegoSoft OCX Control "
   Msg = Msg + "Kit - a collection of various OCX controls. "
   Msg = Msg + CR + CR
   Msg = Msg + "For more information about the "
   Msg = Msg + "TegoSoft OCX Control Kit, contact TegoSoft "
   Msg = Msg + "at:"
   Msg = Msg + CR + CR
   Msg = Msg + "TegoSoft Inc." + CR
   Msg = Msg + "P.O. Box 389" + CR
   Msg = Msg + "Bellmore, NY 11710"
   Msg = Msg + CR + CR
   Msg = Msg + "Phone: [phone]"
   ' Display the About message box.
   MsgBox Msg, vbInformation, Title
End Sub
Private Sub mnuExit_Click()
    Unload Me
End Sub
Private Sub mnuInfo_Click()
    Dim Msg
    Dim BitmapWidth
    Dim BitmapHeight
    If gBMPHandle = 0 Then
       Msg = "BMP is not open."
    Else
       BitmapWidth = Tegwing1.GetBMPWidth(gBMPHandle)
       BitmapHeight = Tegwing1.GetBMPHeight(gBMPHandle)
       Msg = "BMP Width:" + Str(BitmapWidth)
       Msg = Msg + Chr(13) + Chr(10)
       Msg = Msg + "BMP Height:" + Str(BitmapHeight)
    End If
    MsgBox Msg, vbInformation, "Info"
End Sub
Private Sub mnuOpen_Click()
Dim Msg
' Display an Open File dialog box.
On Error GoTo OpenFileError
CommonDialog1.Filter = "All Files (*.*) | *.* |Bitmap Files (*.bmp)|*.bmp"
CommonDialog1.FilterIndex = 2
CommonDialog1.Action = 1
On Error GoTo 0
' Close previous bitmap.
Tegwing1.CloseBMP gBMPHandle
' Update the window's title.
Me.Caption = "The WinG BMP Program"
' Clear the screen.
' Open the BMP.
gBMPHandle = Tegwing1.OpenBMP(CommonDialog1.filename)
' If OpenBMP() failed, tell the user.
If gBMPHandle = 0 Then
   Msg = "Can't open " + CommonDialog1.filename
   Msg = Msg + " (BMP must be 256 colors BMP file)."
   MsgBox Msg, vbInformation, "Error"
   Exit Sub
End If
' Update window title and display the BMP.
Me.Caption = "The WinG BMP Program - (" + CommonDialog1.FileTitle + ")"
DisplayBitmap (gBMPHandle)
Exit Sub
OpenFileError:
Exit Sub
End Sub
Public Sub DisplayBitmap(BMPHandle As Integer)
Dim TypeOfStretch As Long
Dim HandleOfSourceBMP As Integer
Dim SourceWidth, SourceHeight As Integer
Dim SourceX, SourceY As Integer
Dim TargetWidth, TargetHeight As Integer
Dim TargetX, TargetY As Integer
' Initialize variables.
HandleOfSourceBMP = BMPHandle
TypeOfStretch = SRCCOPY
SourceWidth = Tegwing1.GetBMPWidth(BMPHandle)
SourceHeight = Tegwing1.GetBMPHeight(BMPHandle)
SourceY = 0
SourceX = 0
TargetY = 0
TargetX = 0
TargetWidth = Tegwing1.WinGWidth
TargetHeight = Tegwing1.WinGHeight
' Copy the BMP file into WinG
Tegwing1.CopyBMP2WinG TargetX, TargetY, TargetWidth, TargetHeight, _
         HandleOfSourceBMP, SourceX, SourceY, _
         SourceWidth, SourceHeight, TypeOfStretch
' Slam WinG into the screen.
 Tegwing1.SlamIt
End Sub